PROGRAM BLACKJK;
 
 {GAME OF BLACKJACK WRITTEN IN PASCAL BY T.R. STOKES}
 
 CONST
  XINST =       10; {VARIOUS X-Y COORDS FOR SCREEN MESSAGES}
  YINST =        3;
  XWIN  =       11;
  YWIN  =        2;
  XBET  =        8;
  YBET  =        1;
  XOVER =        5;
  YOVER =        4;
  YHAND0=        6; {LEVEL-1 OF CARDS PLAYED}
  
 TYPE
  VEGAS =       (PLAYER,DEALER);
  
 VAR
  DECK                  :ARRAY[1..52] OF INTEGER;
  RANK,SUIT             :INTEGER;
  NAMRANK,NAMSUIT       :STRING;
  CARDSLEFT             :INTEGER;
  SEED                  :INTEGER;
  PERSON                :VEGAS;
  HANDVAL               :ARRAY[1..2] OF INTEGER;
  NACES                 :ARRAY[1..2] OF INTEGER;
  HANDSIZE              :ARRAY[1..2] OF INTEGER;
  BET,DOLLARS           :INTEGER;
  BUST,BJACK,PUSH,WIN   :BOOLEAN;
  XPLYR,YPLYR           :INTEGER;
  XDELR,YDELR           :INTEGER;
  I,J                   :INTEGER; {GENERAL PURPOSE INDICES}
  CARDVAL               :INTEGER;
  REPLY                 :CHAR;
  CHOICE                :SET OF CHAR;
  XHOLE,YHOLE           :INTEGER;
  HOLSUIT,HOLRANK       :STRING;
  DBLDOWN               :BOOLEAN;
  
  
PROCEDURE NEWSCREEN;
 BEGIN
  WRITE(CHR(1),CHR(12));
 END; {NEWSCREEN}
 
PROCEDURE CLEARTOP;
 BEGIN
  GOTOXY(0,0);
  WRITE(CHR(17));       {CLEAR TO END OF LINE}
 END;  {CLEARTOP}
 
PROCEDURE CLEREOL(X,Y:INTEGER);
 BEGIN
  GOTOXY(X,Y);
  WRITE(CHR(17));       {CLEAR TO END OF LINE}
 END; {CLEREOL}

PROCEDURE CLERBOT;
 BEGIN
  GOTOXY(0,YPLYR);
  WRITE(CHR(12));       {CLEAR TO END OF SCREEN}
 END; {CLERBOT}

PROCEDURE SHUFMES;
 BEGIN
  CLEARTOP;
  GOTOXY(5,0);
  WRITE('SHUFFLING-  HAVE A DRINK ON THE HOUSE.');
 END;  {SHUFMES}
  
FUNCTION RND:REAL;
 BEGIN
  RND:=SEED/32767;
  SEED:=(12585*SEED+6975) MOD 32767;
 END; {RND}
 
PROCEDURE FRESHDECK;
 BEGIN
  FOR I:=1 TO 52 DO
   BEGIN
    DECK[I]:=I;
  END; {FOR}
 END;  {FRESHDECK}
 
PROCEDURE SHUFFLE;
 VAR
  TEMP,RI:INTEGER;
 BEGIN
  SHUFMES;
  CARDSLEFT:=52;
   FOR I:=1 TO 52 DO
    BEGIN
     TEMP:=DECK[I];
     RI:=TRUNC(52*RND+1);
     DECK[I]:=DECK[RI];
     DECK[RI]:=TEMP;
    END; {FOR}
   CLEARTOP;
  END; {SHUFFLE}
  
PROCEDURE NAMECARD;
 BEGIN
  NAMRANK:='     ';         {MAKE IT ONE BYTE LONG}
  NAMRANK[1]:=CHR(RANK+48);   {SO THIS WILL WORK}
  IF RANK=1 THEN NAMRANK:='ACE  '
   ELSE IF RANK>9 THEN
    BEGIN
     CASE RANK OF
    10:NAMRANK:='10   ';
    11:NAMRANK:='JACK ';
    12:NAMRANK:='QUEEN';
    13:NAMRANK:='KING ';
     END {RANKCASE}
    END;
    BEGIN
     CASE SUIT OF
    1:NAMSUIT:='CLUBS   ';
    2:NAMSUIT:='DIAMONDS';
    3:NAMSUIT:='HEARTS  ';
    4:NAMSUIT:='SPADES  ';
     END {SUITCASE}
    END;
   END; {NAMECARD}
 
  PROCEDURE RANSUIT(CARD:INTEGER);
   BEGIN
     RANK:=CARD MOD 13;
     IF RANK=0 THEN RANK:=13;
     SUIT:=(CARD-1) DIV 13 + 1;
  END; {RANSUIT}
  
PROCEDURE SETUP;
 BEGIN
  BUST:=FALSE;
  BJACK:=FALSE;
  PUSH:=FALSE;
  WIN:=FALSE;
  DBLDOWN:=FALSE;
  XPLYR:=0;
  YPLYR:=YHAND0;
  XDELR:=26;
  YDELR:=YHAND0;
  FOR I:=1 TO 2 DO
   BEGIN
    HANDVAL[I]:=0;
    NACES[I]:=0;
    HANDSIZE[I]:=0;
   END; {FOR}
 END; {SETUP}
 
 PROCEDURE SHOWHAND;
  VAR
   X,Y,CN  :INTEGER;
  BEGIN
   CASE PERSON OF
  PLAYER:
   BEGIN
    YPLYR:=YPLYR+1;
    Y:=YPLYR;
    X:=XPLYR;
   END;
  DEALER:
   BEGIN
    YDELR:=YDELR+1;
    Y:=YDELR;
    X:=XDELR;
   END;
  END; {CASE}
   NAMECARD;
   GOTOXY(X,Y);
   CN:=Y-YHAND0;
   WRITE(CN:3,')',NAMRANK:6,' OF ',NAMSUIT);
 END; {SHOWHAND}
  
PROCEDURE SCORE;
 VAR ANACE,NAC,CARDVAL:INTEGER;
BEGIN
   CASE PERSON OF
  PLAYER:I:=1;
  DEALER:I:=2;
   END; {CASE}
 CARDVAL:=RANK;
 IF RANK>10 THEN CARDVAL:=10;
 IF RANK=1 THEN NACES[I]:=NACES[I]+1;
 NAC:=NACES[I];
 ANACE:=0;
 IF RANK=1 THEN ANACE:=1;
 HANDVAL[I]:=HANDVAL[I]+CARDVAL+10*ANACE;
   WHILE (HANDVAL[I]>21) AND (NAC>0) DO
    BEGIN
     NACES[I]:=NACES[I]-1;
     HANDVAL[I]:=HANDVAL[I]-10;
    END; {WHILE}
 IF HANDVAL[I]>21 THEN BUST:=TRUE
END; {SCORE}

PROCEDURE PSCORE;
 BEGIN
  GOTOXY(XPLYR+6,YPLYR+1);
  WRITE('TOTAL = ',HANDVAL[1]:3);
 END; {PSCORE}
 
PROCEDURE HSCORE;
 BEGIN
  GOTOXY(XDELR+6,YDELR+1);
  WRITE('TOTAL = ',HANDVAL[2]:3);
 END; {HSCORE}

PROCEDURE WINNINGS;
 BEGIN
  IF NOT PUSH THEN
   BEGIN
    IF DBLDOWN THEN BET:=BET+BET;
    IF WIN THEN DOLLARS:=DOLLARS+BET
    ELSE DOLLARS:=DOLLARS-BET
   END; {NOT PUSH}
  CLEREOL(XWIN,YWIN);
  WRITE('In U.S. of A. Dollars you have $',DOLLARS);
 END; {WINNINGS}
 
PROCEDURE DOWHAT;
 BEGIN
  CLEREOL(XOVER,YOVER);
  REPEAT
   GOTOXY(XOVER,YOVER);
   WRITE('YOUR MONEY ? ');
   READ(REPLY);
  UNTIL REPLY IN CHOICE;
  IF (REPLY='D') AND (HANDSIZE[1]>2) THEN
   BEGIN
    CLEREOL(XINST,YINST);
    WRITE('NO-NO, NOT AFTER 3 OR MORE!!');
    DOWHAT;
   END;
 END; {DOWHAT}
 
PROCEDURE NOSHOW;
 VAR CN:INTEGER;
 BEGIN
  YDELR:=YDELR+1;
  GOTOXY(XDELR,YDELR);
  CN:=YDELR-YHAND0;
  WRITE(CN:3,')   ?????????');
  XHOLE:=XDELR;
  YHOLE:=YDELR;
  HOLSUIT:=NAMSUIT;
  HOLRANK:=NAMRANK;
 END; {NOSHOW}
 
PROCEDURE INSTRUCTIONS;
 BEGIN
  GOTOXY(XINST,YINST);
  WRITE('H)it, G)ood, D)oubledown, S)plitpair');
 END; {INSTRUCTIONS}
 
PROCEDURE PLAYERIN;
 VAR B:CHAR;
BEGIN
 CLEREOL(XBET,YBET);
 WRITE('HOUSE LIMIT IS $200.. BET LIMIT ? (Y/N) ');
 READ(B);
 IF B<>'N' THEN BET:=200
 ELSE
  BEGIN
   REPEAT
   CLEREOL(XBET,YBET);
   WRITE('HOUSE LIMIT IS $200.. BET PLEASE ? ');
   READLN(BET);
  UNTIL BET<201
 END; {REPEAT}
END; {PLAYERIN}

PROCEDURE SHOHOLE;
 VAR CN:INTEGER;
 BEGIN
  GOTOXY(XHOLE,YHOLE);
  CN:=YHOLE-YHAND0;
  WRITE(CN:3,')',HOLRANK:6,' OF ',HOLSUIT);
 END; {SHOHOLE}
   
PROCEDURE DEAL;
 VAR
  K,CARD:INTEGER;
 BEGIN
  K:=CARDSLEFT;
  CARD:=DECK[K];
  RANSUIT(CARD);
  NAMECARD;
  CARDSLEFT:=CARDSLEFT-1;
  IF CARDSLEFT=0 THEN SHUFFLE;
  IF PERSON=PLAYER THEN HANDSIZE[1]:=HANDSIZE[1]+1
   ELSE HANDSIZE[2]:=HANDSIZE[2]+1;
 END; {DEAL}

PROCEDURE DEAL2;
 VAR
   C:INTEGER;
 BEGIN
  FOR C:=1 TO 2 DO
   BEGIN
    FOR PERSON:=PLAYER TO DEALER DO
     BEGIN
      DEAL;
      SCORE;
      IF (PERSON=DEALER) AND (C=1) THEN NOSHOW
      ELSE SHOWHAND
     END; {PERSON}
   END; {FOR}
 END; {DEAL2}
 
PROCEDURE TEST21;
 BEGIN
  IF (HANDVAL[1]=21) OR (HANDVAL[2]=21) THEN
   BEGIN
    BJACK:=TRUE;
    SHOHOLE;
    IF HANDVAL[1]=HANDVAL[2] THEN
     BEGIN
      PUSH:=TRUE;
      CLEREOL(XOVER,YOVER);
      WRITE('* * DOUBLE BLACKJACK !!! - PUSH -');
    END {PUSH}
   ELSE IF HANDVAL[1]=21 THEN
    BEGIN
     WIN:=TRUE;
     BET:=BET+BET DIV 2;
     CLEREOL(XOVER,YOVER);
     WRITE('* * * BLACKJACK !! - PAY 1.5 TIMES BET ');
    END {PLAYERS BLACKJACK}
   ELSE
    BEGIN
     CLEREOL(XOVER,YOVER);
     WRITE('* * DEALER HAS A BLACKJACK !!');
    END;
   END; {BJACK:=TRUE}
  END; {TEST21 - NO BLACKJACK}
  
PROCEDURE DEALPLAYER;
 BEGIN
  PERSON:=PLAYER;
  REPEAT
   DOWHAT;
    IF (REPLY='H') OR (REPLY='D') THEN
     BEGIN
      DEAL;
      SHOWHAND;
      SCORE;
     END
   UNTIL BUST OR (REPLY<>'H') OR (REPLY='D');
  IF BUST THEN
   BEGIN
    CLEREOL(XOVER,YOVER);
    WRITE('YOU BUSTED WITH ',HANDVAL[1]:3);
   END; {IF BUST}
  IF REPLY='D' THEN DBLDOWN:=TRUE;
 END; {DEALPLAYER}
  
PROCEDURE DEALHOUSE;
 BEGIN
  PERSON:=DEALER;
  SHOHOLE;
WHILE (HANDVAL[2]<17) OR ((HANDVAL[2]=17) AND (NACES[2]>0)) DO
   BEGIN
    DEAL;
    SHOWHAND;
    SCORE;
   END; {WHILE}
  HSCORE;
 END; {DEALHOUSE}
 
PROCEDURE EVALUATE;
 VAR HV:INTEGER;
 BEGIN
  IF BUST THEN BEGIN
   WIN:=TRUE;
   CLEREOL(XOVER,YOVER);
   WRITE('THE HOUSE BUSTED WITH ',HANDVAL[2]:3);
  END
  ELSE IF HANDVAL[1]=HANDVAL[2] THEN PUSH:=TRUE
  ELSE IF HANDVAL[1]>HANDVAL[2] THEN WIN:=TRUE;
  IF PUSH THEN BEGIN
   CLEREOL(XOVER,YOVER);
   WRITE(' - PUSH -');
  END;
  HV:=HANDVAL[2];
  IF (NOT PUSH) AND (NOT BUST) THEN
   BEGIN
    CLEREOL(XOVER,YOVER);
    IF HV=21 THEN
     WRITE('DEALER HAS 21!!')
     ELSE WRITE('PAY ',HV+1);
   END; {NOT PUSH}
 END; {EVALUATE}
 
  
 BEGIN          {MAIN PROGRAM}
  CHOICE:=['H','G','D','S'];
  NEWSCREEN;
  WRITE('  PLEASE ENTER A RANDOM NUMBER - ');
  READLN(SEED);
  FRESHDECK;
  SHUFFLE;
  SETUP;
  INSTRUCTIONS;
  PLAYERIN;
  DOLLARS:=0;
  REPEAT
   IF BET>0 THEN BEGIN
    DEAL2;
    TEST21;
    IF NOT BJACK THEN
     BEGIN
      DEALPLAYER;
      PSCORE;
      IF NOT BUST THEN
       BEGIN
        DEALHOUSE;
        EVALUATE;
       END; {IF NOT BUST}
      END; {NOT BJACK}
    END; {BET>0}
   INSTRUCTIONS;
   WINNINGS;
   PLAYERIN;
   SETUP;
   CLERBOT;
  UNTIL BET<0
 END.  {MAIN PROGRAM}

